unit uIEParser;

interface

uses
  SysUtils, Classes, IEParser, IEConst, Windows;

type
  TIEReadTimeOut = class;
  TIEParserEx = class(TIEParser)
  private
    FCurrentThreadId: DWORD;
    FTimeOut: Integer;
    FIEReadTimeOut: TIEReadTimeOut;
    FBusyStateChangeEx: TNotifyEvent;
    procedure OnReadTimeOut(Sender: TObject);
    procedure BusyStateChangeEx(Sender: TObject);
  public
    procedure Cancel;

    constructor Create(Owner: Tcomponent); override;
    destructor Destroy; override;

    property ReadTimeOut: Integer read FTimeOut write FTimeOut;
    property OnBusyStateChangeEx: TNotifyEvent read FBusyStateChangeEx write FBusyStateChangeEx;
  end;

  TIEReadTimeOut = class(TThread)
  private
    FTimeOut: Integer;
    FExitFlag: Boolean;
    FAfterTimeOut: TNotifyEvent;
  protected
    procedure Execute; override;
  public
    constructor Create(ATimeOut: Integer; AfterTimeOut: TNotifyEvent);
    property ExitFlag: Boolean read FExitFlag write FExitFlag;
  end;

implementation

{ TIEReadTimeOut }

constructor TIEReadTimeOut.Create(ATimeOut: Integer; AfterTimeOut: TNotifyEvent);
begin
  FreeOnTerminate := True;
  FTimeOut := ATimeOut;
  FAfterTimeOut := AfterTimeOut;
  FExitFlag := False;

  inherited Create(False);
end;

procedure TIEReadTimeOut.Execute;
var
  t0, t1: Integer;
begin
  try
    t0 := GetTickCount;
    while not FExitFlag do
    begin
      t1 := GetTickCount;
      if t1-t0>=FTimeOut then
      begin
        if Assigned(FAfterTimeOut) then
          FAfterTimeOut(nil);

        Exit;
      end;

      Sleep(100);
    end;
  finally
    Terminate;
  end;
end;

{ TIEParserEx }

procedure TIEParserEx.BusyStateChangeEx(Sender: TObject);
begin
  if Assigned(FBusyStateChangeEx) then
    FBusyStateChangeEx(Self);

  if Busy then
  begin
    if Assigned(FIEReadTimeOut) then
    begin
      FIEReadTimeOut.ExitFlag := True;
    end;
    FIEReadTimeOut := TIEReadTimeOut.Create(FTimeOut, OnReadTimeOut);
  end
  else begin
    FIEReadTimeOut.ExitFlag := True;
  end;
end;

procedure TIEParserEx.Cancel;
begin
  PostThreadMessage(FCurrentThreadId, WM_USER_STARTWALKING, 0, 0);
end;

constructor TIEParserEx.Create(Owner: Tcomponent);
begin
  inherited Create(Owner);
  DownloadOptions := [DontExecuteScripts, DontExecuteJava, DontExecuteActiveX,
    DontDownloadActiveX, DontDownloadBehaviors];
  OnBusyStateChange := BusyStateChangeEx;
  FCurrentThreadId := GetCurrentThreadId;
  FTimeOut := 10000;
end;

destructor TIEParserEx.Destroy;
begin
  if Assigned(FIEReadTimeOut) then
  begin
    FIEReadTimeOut.ExitFlag := True;
  end;
  inherited;
end;

procedure TIEParserEx.OnReadTimeOut(Sender: TObject);
begin
  Cancel;
end;

end.
